ring.yamanashi.ac.jp/pub/pc/freem/action//action.zip/umiact_ver1_1.zip/‚¤‚Ý‚Ë‚±ƒAƒNƒVƒ‡ƒ“Iver1.1/‰¹ŠyŽ©“®ƒRƒs[ƒoƒbƒ`.vbs

Text File | 2010-08-08 | 8KB | 343 lines

Option Explicit

''' Åëè·ë╗Åêù¥
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")

Dim objWshShell
Set objWshShell = CreateObject("WScript.Shell")

dim wcs: set wcs = new WCSwitch


' âXâNâèâvâgé╠âfâBâîâNâgâè
Dim currentDir
currentDir = Replace(WScript.ScriptFullName, WScript.ScriptName,"")


Dim gomi


' Åêù¥îoë▀âìâO
Dim logFile
Set logFile = FSO.OpenTextFile(currentDir & "\log.txt", 2, True)


' î⌐é┬é⌐éτé╚é⌐é┴é╜âtâ@âCâïâèâXâg
Dim logNotFound
Set logNotFound = FSO.OpenTextFile(currentDir & "\notfoundlist.txt", 2, True)



''' ó07th_ExpansionüvâtâHâïâ_é≡ÆTé╖
''' îƒì⌡æ╬Å█âfâBâîâNâgâèüFüuProgramFilesüvüuâhâëâCâuÆ╝ë║üv

'' ProgramFiles
Dim file, sub_folder, path, program_files
program_files = expandEnvironment("%ProgramFiles%")
path = findMainFolder(FSO.GetFolder(program_files))


'' âhâëâCâuÆ╝ë║
If path = -1 Then
   Dim dc
   Set dc = FSO.Drives

   Dim d
   For Each d in dc
       If d.IsReady Then
      path = findMainFolder(FSO.GetFolder(d.DriveLetter & ":\"))
      If path <> -1 Then
         Exit For
      End If
       End If
   Next
End If


If path = -1 Then
   Call exitProgram("07th_ExpansionâtâHâïâ_é¬î⌐é┬é⌐éΦé▄é╣é±é┼é╡é╜üB")
End If


''' éñé▌é╦é▒âtâHâïâ_é≡î⌐é┬é»éΘ
Dim umineko_folders()
ReDim umineko_folders(0)
Call findUminekoFolders(FSO.GetFolder(path),umineko_folders)
gomi = shiftArray(umineko_folders)
printAndLog("ë║ïLé╠âtâHâïâ_é¬î⌐é┬é⌐éΦé▄é╡é╜üB" & vbCrLf & Join(umineko_folders,vbCrLf))


''' BGM,ME,SEâtâHâïâ_é≡î⌐é┬é»éΘ
Dim umineko, BGM_folders(), SE_folders()
ReDim BGM_folders(0), SE_folders(0)
For Each umineko In umineko_folders
    Call findBGMFolder(FSO.GetFolder(umineko), BGM_folders)
    Call findSEFolder(FSO.GetFolder(umineko) , SE_folders)
next
gomi = shiftArray(BGM_folders)
gomi = shiftArray(SE_folders)
PrintAndLog("ë║ïLé╠âtâHâïâ_é¬î⌐é┬é⌐éΦé▄é╡é╜üB" & vbCrLf & Join(BGM_folders,vbCrLf))
PrintAndLog("ë║ïLé╠âtâHâïâ_é¬î⌐é┬é⌐éΦé▄é╡é╜üB" & vbCrLf & Join(SE_folders,vbCrLf))



''' Find
PrintAndLog(vbCrLf & "========== BGM ============")
Dim game_bgm_folder
Set game_bgm_folder = FSO.GetFolder(currentDir & "\bgm")
Call findMusic(BGM_folders, game_bgm_folder, currentDir & "\bgm")
Set game_bgm_folder = Nothing


PrintAndLog(vbCrLf & "========== SE ============")
Dim game_se_folder
Set game_se_folder = FSO.GetFolder(currentDir & "\wave")
Call findMusic(SE_folders, game_se_folder, currentDir & "\wave")
Set game_se_folder = Nothing



''' ÅIù╣Åêù¥
MsgBox "âRâsü[è«ù╣é╡é▄é╡é╜üB"
postProcess


'''''''''''''
''  è╓Éö   ''
'''''''''''''
Function findMainFolder(obj_folder)
    Dim path
    path = -1
    For Each file in obj_folder.SubFolders
        If file.Name = "07th_Expansion" Then
        path = file.path
        Exit For
    End If
    next

    findMainFolder = path
End Function


Sub findUminekoFolders(obj_folder, umineko_folders)
    Dim folder
    For Each folder in obj_folder.SubFolders
        Call pushArray(umineko_folders, folder.path)
    next
End Sub


Sub findBGMFolder(obj_folder, BGM_folders)
    Dim regEx
    Set regEx        = New RegExp
    regEx.Pattern    = "BGM"
    regEx.Global     = True
    regEx.IgnoreCase = True

    Dim folder
    For Each folder In obj_folder.SubFolders
        If regEx.Test(folder.name) Then
       Call pushArray(BGM_folders, folder.path)
    End If
    Next

    Set regEx = Nothing
End Sub


Sub findSEFolder(obj_folder, SE_folders)
    Dim folder
    For Each folder In obj_folder.SubFolders
        If folder.name = "SE" Or folder.name = "ME" Or folder.name = "sys_se" Then
       Call pushArray(SE_folders, folder.path)
    End If
    Next
End Sub


Sub findMusic(music_folders, game_music_folder, dst)
    Dim find_flag

    Dim music_folder
    Dim file, file_name
    For Each file In game_music_folder.files
        file_name = file.Name
    printAndLog "üu" & file_name & "üv" & "îƒì⌡Æå..."
    find_flag = 0
    For Each music_folder In music_folders
        Dim path
        path = findData(FSO.GetFolder(music_folder), file_name)

        If path <> "" Then
                Dim src
                Set src = FSO.GetFile(Path)
             printAndLog path & vbCrLf
                src.Copy dst & "\" & file_name
            find_flag = 1
        Set src = Nothing
                Exit For
            End If
         Next

         If find_flag <> 1 Then
            PrintAndLog "Not Found" & vbCrLf
        logNotFound.WriteLine dst & ":" & file_name
         End If
   Next
End Sub


Function findData(obj_folders, keyname)
    Dim regEx
    Set regEx = New RegExp
    regEx.Pattern = "\.(.*)?"
    regEx.IgnoreCase = True

    Dim oMatch, oMatches, ext
    Set oMatches = regEx.Execute(keyname)
    Set oMatch = oMatches(0)
    Dim name
    name = regEx.Replace(keyname, LCase(oMatch.SubMatches(0)))

    For Each file in obj_folders.Files
        Dim file_name
    Set oMatches = regEx.Execute(file.Name)
    Set oMatch   = oMatches(0)
    file_name = regEx.Replace(file.Name, LCase(oMatch.SubMatches(0)))
        If file_name = name Then
       findData = file.path
    End If
    next
End Function


Function arraySize(array)
    Dim n
    arraySize = UBound(array) - LBound(array) + 1
End Function


Sub pushArray(array, f)
    Dim size
    ReDim Preserve array(UBound(array)+1)
    array(UBound(array)) = f
End Sub


Function popArray(array)
    Dim f
    f = array(UBound(array))
    ReDim Preserve array(UBound(array) - 1)

    popArray = f
End Function


Function shiftArray(array)
    Dim p
    p = array(0)

    Dim i
    For i = 1 To UBound(array) Step 1
        array(i-1) = array(i)
    Next
    ReDim Preserve array(UBound(array) - 1)

    shiftArray = p
End Function


Sub unShiftArray(array, f)
    ReDim Preserve array(UBound(array) + 1)

    Dim i
    For i = 0 To UBound(array)-1  Step 1
        array(i+1) = array(i)
    Next

    array(0) = f
End Sub


Sub PrintAndLog(msg)
    If lcase(right(WScript.Fullname,11)) = "cscript.exe" Then
        WScript.Echo msg
    End If
    logFile.WriteLine(msg)
End Sub


class WCSwitch
    private m_ws, m_env, m_EnvVarName, m_IsCScript

    private sub Class_Initialize()
        set m_ws = CreateObject("WScript.Shell")
        set m_env = m_ws.environment("Volatile")
        m_IsCscript = lcase(right(WScript.Fullname,11)) = "cscript.exe"
        dim vName
        vName = WScript.ScriptFullName
        vName = replace(vName,"\","_")
        vName = replace(vName,":","_")
        m_EnvVarName = vName
        if not m_IsCscript then spawn
    end sub

    private sub Class_Terminate()
        if m_IsCScript and len(m_env(m_EnvVarName)) > 0 then
            msgbox "âvâìâOâëâÇé≡ÅIù╣é╡é▄é╖üB",vbOKOnly,"CScripté⌐éτé╠Æ╩Æm"
            m_env.remove(m_EnvVarName)
        end if
    end sub

    private sub spawn
        const DQ = """", HDQ = "^"""

        dim oExec,sCmdline
        sCmdline = "cmd /C " & DQ & _
            "start cscript //nologo " & _
            HDQ & WScript.ScriptFullName & HDQ &  DQ
        m_env(m_EnvVarName)="1"
        set oExec = m_ws.Exec(sCmdLine)
        do while oExec.status = 0
            wscript.sleep 100
        loop
        wscript.quit
    end sub

end class


Function expandEnvironment(environment)
   On Error Resume Next

   Dim objWshShell
   Dim strEnvironment

   Set objWshShell = WScript.CreateObject("WScript.Shell")
   If Err.Number = 0 Then
      expandEnvironment = objWshShell.ExpandEnvironmentStrings(environment)
   Else
      WScript.Echo "âGâëü[üF" & Err.Description
   End If

   Set objWshShell = Nothing
End Function


Sub exitProgram(msg)
    MsgBox msg
    PostProcess
    WScript.Quit
End Sub


Sub postProcess
    logFile.Close
    logNotFound.Close
    Set FSO = Nothing
    Set objWshShell = Nothing
    Set logFile = Nothing
    Set objWshShell = Nothing
    Set wcs = Nothing
End Sub